Unit
	GenericTemplate;

Interface

Uses
	Classes,
	SysUtils,
	RTTIObject;

Const
	ccTemplateDir = '.\templates\';

Type
	TCustomKey = Class
	Private
		fKey : String;
	Public
		Constructor Create(Const aKey : String); Virtual;
		Function GetKeyValue: String; Virtual; Abstract;
		Property Key : String Read fKey;
		Property Value : String Read GetKeyValue;
	End;

	TValueKey = Class(TCustomKey)
	Private
		fValue : String;
	Public
		Procedure SetKeyValue(Const aValue : String);
		Function GetKeyValue: String; Override;
	End;
	
	TPropertyKey = Class(TCustomKey)
	Private
		fObject,
		fProperty : String;
	Public
		Procedure SetKeyValue(Const aObject, aProperty : String);
		Function GetKeyValue: String; Override;
	End;
	
	TChildsKey = Class(TCustomKey)
	Private
		fObject : String;
	Public
		Procedure SetKeyValue(Const aObject : String);
		Function GetKeyValue: String; Override;
	End;
	
	TObjectKey = Class(TCustomKey)
	Private
		fObject : String;
	Public
		Procedure SetKeyValue(Const aObject : String);
		Function GetKeyValue: String; Override;
	End;

	TTemplate = Class(TRTTIObject)
	Private
		fFileName : String;
		fKeys : Array Of TCustomKey;
		Function LoadFile(Const aFile : String): String;
	Public
		Destructor Destroy; Override;
		Function AddCustomKey(Const aKey : TCustomKey): TCustomKey;
		Function AddValueKey(Const aKey : String): TValueKey;
		Function AddRTTIPropertyKey(Const aKey : String): TPropertyKey;
		Function AddRTTIChildsKey(Const aKey : String): TChildsKey;
		Function AddRTTIObjectKey(Const aKey : String): TObjectKey;
		Procedure AddRTTIObjectProperties(Const aObject : String);
		Function Show: String; Override;
	Published
		Property FileName : String Read fFileName Write fFileName;
	End;
	
Implementation

Constructor TCustomKey.Create(Const aKey : String);
Begin
	Inherited Create;
	fKey := aKey;
End;

Procedure TValueKey.SetKeyValue(Const aValue : String);
Begin
	fValue := aValue;
End;

Function TValueKey.GetKeyValue: String;
Begin
	Result := fValue;
End;

Procedure TPropertyKey.SetKeyValue(Const aObject, aProperty : String);
Begin
	fObject := aObject;
	fProperty := aProperty;
End;

Function TPropertyKey.GetKeyValue: String;
Begin
	// Debug  WriteLn(fObject, '=', fProperty);
	Result := Factory.FindInstance(fObject).Properties[fProperty];
End;
	
Procedure TChildsKey.SetKeyValue(Const aObject : String);
Begin
	// Debug WriteLn('Adding the childs of ', aObject);
	fObject := aObject;
End;

Function TChildsKey.GetKeyValue: String;
Begin
	Result := Factory.FindInstance(fObject).ShowChilds;
End;

Procedure TObjectKey.SetKeyValue(Const aObject : String);
Begin
	// Debug  WriteLn('Object : ', aObject);
	fObject := aObject;
End;

Function TObjectKey.GetKeyValue: String;
Begin
	Result := Factory.FindInstance(fObject).Show;
End;

Destructor TTemplate.Destroy;
Var
	lCtrl : Integer;
Begin
	For lCtrl := Low(fKeys) To High(fKeys) Do
		fKeys[lCtrl].Free;
	SetLength(fKeys, 0);
	Inherited Destroy;
End;

Function TTemplate.AddCustomKey(Const aKey : TCustomKey): TCustomKey;
Begin
	SetLength(fKeys, Length(fKeys) + 1);
	fKeys[High(fKeys)] := aKey;
	Result := aKey;
End;

Function TTemplate.AddValueKey(Const aKey : String): TValueKey;
Begin
	Result := AddCustomKey(TValueKey.Create(aKey)) As TValueKey;
End;

Function TTemplate.AddRTTIPropertyKey(Const aKey : String): TPropertyKey;
Begin
	Result := AddCustomKey(TPropertyKey.Create('property:' + aKey)) As TPropertyKey;
End;

Function TTemplate.AddRTTIChildsKey(Const aKey : String): TChildsKey;
Begin
	Result := AddCustomKey(TChildsKey.Create('childs')) As TChildsKey;
End;

Function TTemplate.AddRTTIObjectKey(Const aKey : String): TObjectKey;
Begin
	Result := AddCustomKey(TObjectKey.Create('instance:' + aKey)) As TObjectKey;
End;

Procedure TTemplate.AddRTTIObjectProperties(Const aObject : String);
Var
	lCtrl : Integer;
	lObject : TRTTIObject;
Begin
	// Debug  WriteLn('Adding all properties of the object ', aObject, ' to the template keys.');
	lObject := Factory.FindInstance(aObject);
	For lCtrl := 0 To lObject.PropertyCount - 1 Do
		If lObject.IsObjectProperty(lCtrl) Then
		Begin
			If Not(Factory.FindInstance(lObject.PropertiesByIndex[lCtrl]) Is TTemplate) Then
			Begin
				// Debug  WriteLn(lObject.ClassName, ':', lObject.GetPropertyName(lCtrl), '=', lObject.PropertiesByIndex[lCtrl]);
				AddRTTIObjectKey(lObject.GetPropertyName(lCtrl)).SetKeyValue(lObject.Properties[lObject.GetPropertyName(lCtrl)]);
			End;
		End
		Else
		Begin
		 // Debug  WriteLn(lObject.ClassName, ':', lObject.GetPropertyName(lCtrl), '=', lObject.PropertiesByIndex[lCtrl]);
			AddRTTIPropertyKey(lObject.GetPropertyName(lCtrl)).SetKeyValue(lObject.InstanceName, lObject.GetPropertyName(lCtrl));
		End;
End;

Function TTemplate.LoadFile(Const aFile : String): String;
Var
	lBuffer : TStringList;
Begin
	lBuffer := TStringList.Create;
	lBuffer.LoadFromFile(ccTemplateDir + ExtractFileName(aFile));
	Result := lBuffer.Text;
	lBuffer.Free;
End;

Function TTemplate.Show: String;
Var
	lCtrl : Integer;
Begin
	// Debug  WriteLn('Loading file ', fFileName);
	Result := LoadFile(fFileName);
	// Debug  WriteLn('Replacing keys (', Length(fKeys), ').');
	For lCtrl := Low(fKeys) to High(fKeys) Do
	Begin
		// Debug  WriteLn(lCtrl, ':', fKeys[lCtrl].Key, ':', fKeys[lCtrl].ClassName);
		// Debug  WriteLn(Result);
		Result := StringReplace(Result, '<%' + fKeys[lCtrl].Key + '%>', fKeys[lCtrl].Value, [ rfReplaceAll, rfIgnoreCase ]);
  // Debug  WriteLn(Result);		
		// Debug  WriteLn('Done.');
	End;
End;

Initialization

	Factory.Register(TTemplate);

End.